home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / ROSETTES.ZIP / ROSETTES.BAS next >
BASIC Source File  |  1994-09-01  |  5KB  |  189 lines
  1. Declare Sub SetCursorPos Lib "USER" (ByVal X As Integer, ByVal Y As Integer)
  2. Global Const KEYDOWNEXIT = -1
  3. Global WAITING%
  4. Global FIRSTTIME%
  5. Global LASTX!, LASTY!
  6.  
  7. Sub DRAWROSETTES ()
  8.  
  9. ' My only contribution to this program.
  10.  
  11. ReDim VX%(100), VY%(100), NUM%(99) ' Arrays for vertex co-ords and # of sides
  12.  
  13. ' set internal scale
  14.  
  15. Form1.ScaleHeight = (screen.Height \ screen.TwipsPerPixelY)
  16. Form1.ScaleWidth = (screen.Width \ screen.TwipsPerPixelX) ' use for circular shapes
  17. 'Form1.ScaleWidth = Form1.ScaleHeight   ' use to fill screen
  18.  
  19. SW% = Form1.ScaleWidth \ 2         ' locate center of form
  20. SH% = Form1.ScaleHeight \ 2
  21.  
  22. PI# = 4 * Atn(1)
  23. A% = 0            ' drawing starts or ends at center
  24. B% = SH% - 5      ' drawing stops before going off screen
  25. W% = 52           ' this gave some shapes my wife could live with.
  26. Z% = 1            ' used to change drawing direction
  27.  
  28. For P% = 0 To 99                   ' load # of sides array
  29.    DRAWNUM% = P%
  30.    Select Case DRAWNUM%            ' some numbers give dreadful results
  31.       Case 0, 8, 16, 28, 65        ' according to my wife
  32.          DRAWNUM% = 42
  33.       Case 1, 9, 20, 29, 78
  34.          DRAWNUM% = 45
  35.       Case 2, 10, 22, 30, 79
  36.          DRAWNUM% = 46
  37.       Case 3, 11, 23, 32, 91
  38.          DRAWNUM% = 47
  39.       Case 4, 12, 24, 33, 93
  40.          DRAWNUM% = 49
  41.       Case 5, 13, 25, 34, 95
  42.          DRAWNUM% = 50
  43.       Case 6, 14, 26, 39
  44.          DRAWNUM% = 51
  45.       Case 7, 15, 27, 52
  46.          DRAWNUM% = 54
  47.    End Select
  48.    NUM%(P%) = DRAWNUM%
  49. Next P%
  50.  
  51. Randomize
  52.  
  53. Do
  54.    Todraw% = NUM%(Int(Rnd * 100))   ' how many sides
  55.    
  56.    If Todraw% Mod 22 = 0 Then        ' every so often make backcolor black
  57.       RRR% = 0
  58.       GGG% = 0
  59.       BBB% = 0
  60.    Else                             ' else select random backcolor
  61.       RRR% = Int(Rnd * 256)
  62.       GGG% = Int(Rnd * 256)
  63.       BBB% = Int(Rnd * 256)
  64.    End If
  65.    
  66.    Form1.BackColor = RGB(RRR%, GGG%, BBB%)
  67.  
  68.    D% = Z% * (Int(Rnd * 6) + 5)         ' determine step size
  69.  
  70.    For LOOPINGNUM% = A% To B% Step D%   ' start drawing process
  71.  
  72.       ' Determine vertex co-ords of a regular polygon of ToDraw% sides
  73.       
  74.       For LOOPNUM% = 0 To Todraw%       ' load co-ord arrays
  75.          VX%(LOOPNUM%) = SW% + LOOPINGNUM% * Cos(W% * PI# * LOOPNUM% / Todraw%)
  76.          VY%(LOOPNUM%) = SH% + LOOPINGNUM% * Sin(W% * PI# * LOOPNUM% / Todraw%)
  77.       Next LOOPNUM%
  78.       VX%(Todraw% + 1) = VX%(0)         ' last vertex same as first vertex
  79.       VY%(Todraw% + 1) = VY%(0)
  80.  
  81.       C% = C% + Int(6 * Rnd) + 1       ' select line drawing color
  82.       If C% > 15 Then C% = C% - 15
  83.       
  84.       For LOOPNUM% = 0 To Todraw%       ' connect the dots
  85.          If LOOPNUM% Mod 10 = 0 Then DoEvents  ' cede control to other apps
  86.          Form1.Line (VX%(LOOPNUM%), VY%(LOOPNUM%))-(VX%(LOOPNUM% + 1), VY%(LOOPNUM% + 1)), QBColor(C%)
  87.       Next LOOPNUM%
  88.    
  89.    Next LOOPINGNUM%
  90.    
  91.    WAIT 2     ' hold on screen for 2 seconds
  92.    
  93.    F% = A%    ' interchange drawing variables
  94.    A% = B%
  95.    B% = F%
  96.    Z% = -Z%   ' and reverse drawing direction
  97.  
  98. Loop
  99.  
  100. End Sub
  101.  
  102. Sub HIDECURSOR ()
  103.     
  104.     ' Move cursor off screen to bottom right.
  105.     ' This routine is from The Cobb Group's
  106.     ' Inside VB for Windows magazine
  107.     
  108.     XPOS% = screen.Width
  109.     YPOS% = screen.Height
  110.     Call SetCursorPos(XPOS%, YPOS%)
  111.     LASTX! = XPOS%
  112.     LASTY! = YPOS%
  113. End Sub
  114.  
  115. Sub MAIN ()
  116.     
  117.     If APP.PrevInstance Then  ' Only allow one copy at a time to run
  118.         End
  119.     End If
  120.     
  121.     WAITING% = False
  122.     
  123.     Form1.Show
  124.     
  125.     If UCase$(Command$) = "/C" Then
  126.        Result% = MsgBox("This screensaver has no setup parameters", 4144, "ROSETTES SETUP")
  127.        End
  128.     End If
  129.  
  130.     HIDECURSOR
  131.     DRAWROSETTES
  132. End Sub
  133.  
  134. Sub MONITOREVENTS (X As Single, Y As Single)
  135.     
  136.     ' Check if screensaver should end. This routine is from The Cobb Group's
  137.     ' Inside VB for Windows magazine
  138.     
  139.     ' According to The Cobb Group Windows generates (for VB) spurious
  140.     ' mousemove events on an interval matching the screensaver time delay
  141.     ' set in Control Panel. The next If structure traps them.
  142.     
  143.     If X = LASTX! And Y = LASTY! Then
  144.         Exit Sub
  145.     Else
  146.         LASTX! = X
  147.         LASTY! = Y
  148.     End If
  149.  
  150.     If (Not FIRSTTIME%) Or LASTX! = KEYDOWNEXIT Then
  151.         QUITSCREENSAVER
  152.     Else
  153.         Call WAIT(1)
  154.         FIRSTTIME% = False
  155.     End If
  156. End Sub
  157.  
  158. Sub QUITSCREENSAVER ()
  159.     End
  160. End Sub
  161.  
  162. Sub WAIT (TIMETOWAIT%)
  163.     
  164.     ' Routine to hold drawing on screen for a set number of seconds.
  165.     ' This routine is from The Cobb Group's
  166.     ' Inside VB for Windows magazine
  167.     
  168.     If TIMETOWAIT% <= 0 Then Exit Sub  ' check for valid parameter
  169.     If WAITING% Then Exit Sub  ' do not allow re-entry while routine is active
  170.     WAITING% = True
  171.     TIMEADJ! = 24! * 60 * 60  ' Used if time goes past midnight
  172.     STARTTIME! = Timer
  173.  
  174.     Do
  175.         DoEvents                ' relinquish control
  176.         CURRENTTIME! = Timer
  177.         
  178.         If CURRENTTIME! < STARTTIME! Then
  179.             STARTTIME! = STARTTIME! - TIMEADJ!
  180.         End If
  181.  
  182.         ELAPSEDTIME! = CURRENTTIME! - STARTTIME!
  183.     Loop While ELAPSEDTIME! < TIMETOWAIT%
  184.  
  185.     WAITING% = False
  186.  
  187. End Sub
  188.  
  189.